Sub 切纸机计划量分配PM4()
'by IMRUCOMING 2014/06/16

total1 = total2 = total3 = total4 = 0      'm1wei9台机白班计划量
jilcol = 9     'jihualiang 列数num
zhlcol = 25    'zheheliang 列数num
widthcol = 6     '母卷宽幅列数
sizecol = 7    'size column num
sizc = 5.5     'size change zheheliang  20min
ma = 7.5 / 8 * 132 '白班计划量
mm = 8 / 8 * 132 '中班计划量
mn = 8 / 8 * 132 '夜班计划量


For j = 1 To 7
n1 = 0
n2 = 0
n3 = 0
n4 = 0         'n1,n2,n3,n4为日、中、夜、日班完成的计划量
rs = Cells(ActiveCell.Row, jilcol).value      '第9列为计划量，初始剩余计划量
rscalcu = Cells(ActiveCell.Row, zhlcol).value  '第22列为折合量，初始剩余折合量
wid0 = Int(Cells(ActiveCell.Row, widthcol).value / width(Cells(ActiveCell.Row, sizecol))) * width(Cells(ActiveCell.Row, sizecol))     '第6列为初始规格


m = 0                   'm为该班组完成折合量
'初始值设定完毕、、、白班分配开始
m = rscalcu
m0 = 0         'm0为该班组已安排完成折合量
k = 0
 Do While m < ma And k < 50   '防止无限循环
 ActiveCell = rs
 wid0 = width(Cells(ActiveCell.Row, sizecol))
 n1 = n1 + ActiveCell.value
 m0 = m
 k = k + 1
 ActiveCell.Offset(1, 0).Select
 If Int(Cells(ActiveCell.Row, widthcol).value / width(Cells(ActiveCell.Row, sizecol))) * width(Cells(ActiveCell.Row, sizecol)) = wid0 Then m = m + Cells(ActiveCell.Row, zhlcol).value
 If Int(Cells(ActiveCell.Row, widthcol).value / width(Cells(ActiveCell.Row, sizecol))) * width(Cells(ActiveCell.Row, sizecol)) <> wid0 Then m = m + Cells(ActiveCell.Row, zhlcol).value + sizc '第6列为规格，判断是否需要改规格
 rs = Cells(ActiveCell.Row, jilcol).value
 Loop
If Int(Cells(ActiveCell.Row, widthcol).value / width(Cells(ActiveCell.Row, sizecol))) * width(Cells(ActiveCell.Row, sizecol)) = wid0 Then m0 = m0 Else m0 = m0 + sizc '第6列为规格，判断是否需要改规格
If m0 < ma Then ActiveCell = (ma - m0) / Cells(ActiveCell.Row, zhlcol).value * Cells(ActiveCell.Row, jilcol)
If m0 >= ma Then ActiveCell = 0
If ActiveCell < 1 Then ActiveCell = ""     '转折点判断是否需进入下一规格
n1 = n1 + ActiveCell.value
rs = rs - ActiveCell.value
rscalcu = m - ma
ActiveCell.Offset(0, 1).Select
'白班分配完毕，开始中班分配
m = rscalcu
m0 = 0         'm0为该班组已安排完成折合量
k = 0
 Do While m < mm And k < 50   '防止无限循环
 ActiveCell = rs
 If ActiveCell < 0.5 Then ActiveCell = ""
 wid0 = width(Cells(ActiveCell.Row, sizecol))
 n2 = n2 + ActiveCell.value
 m0 = m
 k = k + 1
 ActiveCell.Offset(1, 0).Select
 If Int(Cells(ActiveCell.Row, widthcol).value / width(Cells(ActiveCell.Row, sizecol))) * width(Cells(ActiveCell.Row, sizecol)) = wid0 Then m = m + Cells(ActiveCell.Row, zhlcol).value
 If Int(Cells(ActiveCell.Row, widthcol).value / width(Cells(ActiveCell.Row, sizecol))) * width(Cells(ActiveCell.Row, sizecol)) <> wid0 Then m = m + Cells(ActiveCell.Row, zhlcol).value + sizc '第6列为规格，判断是否需要改规格
 rs = Cells(ActiveCell.Row, jilcol).value
 Loop
If Int(Cells(ActiveCell.Row, widthcol).value / width(Cells(ActiveCell.Row, sizecol))) * width(Cells(ActiveCell.Row, sizecol)) = wid0 Then m0 = m0 Else m0 = m0 + sizc '第6列为规格，判断是否需要改规格
If m0 < mm Then ActiveCell = (mm - m0) / Cells(ActiveCell.Row, zhlcol).value * Cells(ActiveCell.Row, jilcol)
If m0 >= mm Then ActiveCell = 0
If ActiveCell < 1 Then ActiveCell = ""     '转折点判断是否需进入下一规格
n2 = n2 + ActiveCell.value
rs = rs - ActiveCell.value
rscalcu = m - mm
ActiveCell.Offset(0, 1).Select
'中班班分配完毕，开始夜班分配
m = rscalcu
m0 = 0         'm0为该班组已安排完成折合量
k = 0
 Do While m < mn And k < 50   '防止无限循环
 ActiveCell = rs
 If ActiveCell < 0.5 Then ActiveCell = ""
 wid0 = width(Cells(ActiveCell.Row, sizecol))
 n3 = n3 + ActiveCell.value
 m0 = m
 k = k + 1
 ActiveCell.Offset(1, 0).Select
 If Int(Cells(ActiveCell.Row, widthcol).value / width(Cells(ActiveCell.Row, sizecol))) * width(Cells(ActiveCell.Row, sizecol)) = wid0 Then m = m + Cells(ActiveCell.Row, zhlcol).value
 If Int(Cells(ActiveCell.Row, widthcol).value / width(Cells(ActiveCell.Row, sizecol))) * width(Cells(ActiveCell.Row, sizecol)) <> wid0 Then m = m + Cells(ActiveCell.Row, zhlcol).value + sizc '第6列为规格，判断是否需要改规格
 rs = Cells(ActiveCell.Row, jilcol).value
 Loop
If Int(Cells(ActiveCell.Row, widthcol).value / width(Cells(ActiveCell.Row, sizecol))) * width(Cells(ActiveCell.Row, sizecol)) = wid0 Then m0 = m0 Else m0 = m0 + sizc '第6列为规格，判断是否需要改规格
If m0 < mn Then ActiveCell = (mn - m0) / Cells(ActiveCell.Row, zhlcol).value * Cells(ActiveCell.Row, jilcol)
If m0 >= mn Then ActiveCell = 0
If ActiveCell < 1 Then ActiveCell = ""     '转折点判断是否需进入下一规格
n3 = n3 + ActiveCell.value
rs = rs - ActiveCell.value
rscalcu = m - mn
ActiveCell.Offset(0, 1).Select
'夜班班分配完毕，开始分配日班剩余量
ActiveCell = rs
If ActiveCell < 0.5 Then ActiveCell = ""
n4 = ActiveCell.value
Do While Cells(ActiveCell.Row + 1, jilcol) <> 0
ActiveCell.Offset(1, 0).Select
ActiveCell = Cells(ActiveCell.Row, jilcol)
n4 = ActiveCell.value + n4
Loop
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(0, -3).Select
Selection.NumberFormatLocal = "0"         '单元格式变化
ActiveCell = n1      '剩余日班总计划量
ActiveCell.Offset(0, 1).Select
Selection.NumberFormatLocal = "0"
ActiveCell = n2    '剩余中班总计划量
ActiveCell.Offset(0, 1).Select
Selection.NumberFormatLocal = "0"
ActiveCell = n3   '剩余夜班总计划量
ActiveCell.Offset(0, 1).Select
Selection.NumberFormatLocal = "0"
ActiveCell = n4                     '白班剩余计划量
ActiveCell.Offset(1, -3).Select
total1 = total1 + n1
total2 = total2 + n2
total3 = total3 + n3
total4 = total4 + n4
Next j
ActiveCell.Select
Selection.NumberFormatLocal = "0"         '单元格式变化
ActiveCell = total1 + 1
ActiveCell.Offset(0, 1).Select
Selection.NumberFormatLocal = "0"
ActiveCell = total2
ActiveCell.Offset(0, 1).Select
Selection.NumberFormatLocal = "0"
ActiveCell = total3
ActiveCell.Offset(0, 1).Select
Selection.NumberFormatLocal = "0"
ActiveCell = total4
ActiveCell.Offset(1, -3).Select
End Sub

Sub 切纸机计划量分配PM6()
'by IMRUCOMING 2014/06/16
Range("J4").Select
total1 = total2 = total3 = total4 = 0      'm1wei9台机白班计划量
jilcol = 9     'jihualiang 列数num
zhlcol = 25    'zheheliang 列数num
widthcol = 6     '母卷宽幅列数
sizecol = 7    'size column num
sizc = 0.5 / 8 * 115.2 'size change zheheliang  20min
ma = 7.5 / 8 * 115.2 '白班计划量
mm = 8 / 8 * 115.2 '中班计划量
mn = 8 / 8 * 115.2 '夜班计划量


For j = 1 To 11
n1 = 0
n2 = 0
n3 = 0
n4 = 0         'n1,n2,n3,n4为日、中、夜、日班完成的计划量
rs = Cells(ActiveCell.Row, jilcol).value      '第9列为计划量，初始剩余计划量
rscalcu = Cells(ActiveCell.Row, zhlcol).value  '第22列为折合量，初始剩余折合量
size0 = Cells(ActiveCell.Row, sizecol).value    '第7列为初始规格


m = 0                   'm为该班组完成折合量
'初始值设定完毕、、、白班分配开始
m = rscalcu
m0 = 0         'm0为该班组已安排完成折合量
k = 0
 Do While m < ma And k < 50   '防止无限循环
 ActiveCell = rs
 size0 = Cells(ActiveCell.Row, sizecol).value    '第7列为初始规格
 n1 = n1 + ActiveCell.value
 m0 = m
 k = k + 1
 ActiveCell.Offset(1, 0).Select
 
 sizenow = Cells(ActiveCell.Row, sizecol).value  '第7列为目前规格
 If sizenow = size0 Then m = m + Cells(ActiveCell.Row, zhlcol).value
 If sizenow <> size0 Then m = m + Cells(ActiveCell.Row, zhlcol).value + sizc '第6列为规格，判断是否需要改规格
 
 rs = Cells(ActiveCell.Row, jilcol).value
 Loop
sizenow = Cells(ActiveCell.Row, sizecol).value  '第7列为目前规格
If sizenow = size0 Then m0 = m0 Else m0 = m0 + sizc '第6列为规格，判断是否需要改规格
If m0 < ma Then ActiveCell = (ma - m0) / Cells(ActiveCell.Row, zhlcol).value * Cells(ActiveCell.Row, jilcol)
If m0 >= ma Then ActiveCell = 0
If ActiveCell < 1 Then ActiveCell = ""     '转折点判断是否需进入下一规格
n1 = n1 + ActiveCell.value
rs = rs - ActiveCell.value
rscalcu = m - ma
ActiveCell.Offset(0, 1).Select
'白班分配完毕，开始中班分配
size0 = Cells(ActiveCell.Row, sizecol).value    '第7列为初始规格
m = rscalcu
m0 = 0         'm0为该班组已安排完成折合量
k = 0
 Do While m < mm And k < 50   '防止无限循环
 ActiveCell = rs
 If ActiveCell < 0.5 Then ActiveCell = ""
 size0 = Cells(ActiveCell.Row, sizecol).value    '第7列为初始规格
 n2 = n2 + ActiveCell.value
 m0 = m
 k = k + 1
 ActiveCell.Offset(1, 0).Select
 
 sizenow = Cells(ActiveCell.Row, sizecol).value  '第7列为目前规格
 If sizenow = size0 Then m = m + Cells(ActiveCell.Row, zhlcol).value
 If sizenow <> size0 Then m = m + Cells(ActiveCell.Row, zhlcol).value + sizc '第6列为规格，判断是否需要改规格
 
 rs = Cells(ActiveCell.Row, jilcol).value
 Loop
sizenow = Cells(ActiveCell.Row, sizecol).value  '第7列为目前规格
If sizenow = size0 Then m0 = m0 Else m0 = m0 + sizc '第6列为规格，判断是否需要改规格
If m0 < mm Then ActiveCell = (mm - m0) / Cells(ActiveCell.Row, zhlcol).value * Cells(ActiveCell.Row, jilcol)
If m0 >= mm Then ActiveCell = 0
If ActiveCell < 1 Then ActiveCell = ""     '转折点判断是否需进入下一规格
n2 = n2 + ActiveCell.value
rs = rs - ActiveCell.value
rscalcu = m - mm
ActiveCell.Offset(0, 1).Select
'中班班分配完毕，开始夜班分配
size0 = Cells(ActiveCell.Row, sizecol).value    '第7列为初始规格
m = rscalcu
m0 = 0         'm0为该班组已安排完成折合量
k = 0
 Do While m < mn And k < 50   '防止无限循环
 ActiveCell = rs
 If ActiveCell < 0.5 Then ActiveCell = ""
 size0 = Cells(ActiveCell.Row, sizecol).value    '第7列为初始规格
 n3 = n3 + ActiveCell.value
 m0 = m
 k = k + 1
 ActiveCell.Offset(1, 0).Select
 sizenow = Cells(ActiveCell.Row, sizecol).value  '第7列为目前规格
 If sizenow = size0 Then m = m + Cells(ActiveCell.Row, zhlcol).value
 If sizenow <> size0 Then m = m + Cells(ActiveCell.Row, zhlcol).value + sizc '第6列为规格，判断是否需要改规格
 
 rs = Cells(ActiveCell.Row, jilcol).value
 Loop
sizenow = Cells(ActiveCell.Row, sizecol).value  '第7列为目前规格
If sizenow = size0 Then m0 = m0 Else m0 = m0 + sizc '第6列为规格，判断是否需要改规格
If m0 < mn Then ActiveCell = (mn - m0) / Cells(ActiveCell.Row, zhlcol).value * Cells(ActiveCell.Row, jilcol)
If m0 >= mn Then ActiveCell = 0
If ActiveCell < 1 Then ActiveCell = ""     '转折点判断是否需进入下一规格
n3 = n3 + ActiveCell.value
rs = rs - ActiveCell.value
rscalcu = m - mn
ActiveCell.Offset(0, 1).Select
'夜班班分配完毕，开始分配日班剩余量
ActiveCell = rs
If ActiveCell < 0.5 Then ActiveCell = ""
n4 = ActiveCell.value
Do While Cells(ActiveCell.Row + 1, jilcol) <> 0
ActiveCell.Offset(1, 0).Select
ActiveCell = Cells(ActiveCell.Row, jilcol)
n4 = ActiveCell.value + n4
Loop
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(0, -3).Select
Selection.NumberFormatLocal = "0"         '单元格式变化
ActiveCell = n1      '剩余日班总计划量
ActiveCell.Offset(0, 1).Select
Selection.NumberFormatLocal = "0"
ActiveCell = n2    '剩余中班总计划量
ActiveCell.Offset(0, 1).Select
Selection.NumberFormatLocal = "0"
ActiveCell = n3   '剩余夜班总计划量
ActiveCell.Offset(0, 1).Select
Selection.NumberFormatLocal = "0"
ActiveCell = n4                     '白班剩余计划量
ActiveCell.Offset(1, -3).Select
total1 = total1 + n1
total2 = total2 + n2
total3 = total3 + n3
total4 = total4 + n4
Next j
ActiveCell.Select
Selection.NumberFormatLocal = "0"         '单元格式变化
ActiveCell = total1 + 1
ActiveCell.Offset(0, 1).Select
Selection.NumberFormatLocal = "0"
ActiveCell = total2
ActiveCell.Offset(0, 1).Select
Selection.NumberFormatLocal = "0"
ActiveCell = total3
ActiveCell.Offset(0, 1).Select
Selection.NumberFormatLocal = "0"
ActiveCell = total4
ActiveCell.Offset(1, -3).Select
End Sub

